Garbo/Garbo.cdr/mac/hypercrd/hc1_2_x/qckcmpct.sit/Quick Compacter 2.0/stack.txt

Text File | 1990-02-01 | 11KB | 359 lines

-- stack: in.0
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 2588
-- card count: 1
-- first card id: 2975
-- list block id: 2138
-- print block id: 0
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 57504 bytes
-- stack block size: 17920 bytes
-- created by hypercard version: 0x01228000
-- compacted by hypercard version: 0x01258000
-- modified by hypercard version: 0x01258000
-- opened by hypercard version: 0x01258000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
--- This is version 2.0 of Quick Compacter. It was released on Feb 1
--- 1990.
--- Startup script was copied from the Apple Q&A stack (version 3.2.1).
--- Thanks Apple!
on startup
  set cursor to watch
  global startups
  add 1 to startups
  if startups = 1 then send startup to Home
  set userLevel to 5
  choose browse tool
end startup
on OpenStack
  global totsav,nmQC,f1,DQC,prefshi,shs
  if the version<1.2 then
    beep
    answer "Sorry, you must use HyperCard version 1.2 or greater." with "OK"
    go home
    exit openstack
  end if
  set cursor to watch
  hide msg
  send UpdatePrefs to background
  if item 9 of prefshi=false then hide menubar
  if item 3 of prefshi=true then
    lock screen
    put TKdoTEXT(StartInfo) into cd fld StartInfo
    show cd fld "StartInfo"
    unlock screen with wipe right
    select line 12 of cd fld "StartInfo"
    repeat until the mouse is down
    end repeat
    lock screen
    hide cd fld "StartInfo"
    put empty into cd fld "StartInfo"
    unlock screen with wipe left
  end if
  send CleanUp to background
  hide tool window
  hide pattern window
  if cd fld "Title" is not empty and cd fld "Totsavings" is not empty then
    answer "Some information was left in the Report field" with "Clear It" or "Leave It"
    set cursor to watch
    lock screen
    if it= "Clear It" then
      put empty into cd fld "Title"
      put empty into cd fld "BSaved"
      put empty into cd fld "PerSaved"
      put 0 into cd fld "Totsavings"
      put 0 into cd fld "Totsavings2"
    end if
    set the scroll of cd fld id 4 to 0
    set the scroll of cd fld id 25 to 0
    set the scroll of cd fld id 53 to 0
    unlock screen
  end if
  put cd fld "Totsavings2" into totsav
  put long name of this stack into nmQC
  repeat with i=7 down to 1
    delete char i of nmQC
  end repeat
  delete last char of nmQC
  put empty into DQC
  put TKpathName("Vol",nmQC) into DQC
  delete last char of DQC
  put "Help File" into shs
  ClearScreen
  UD
end OpenStack
on ClearScreen
  set the userLevel to 5
  lock screen
  choose select tool
  doMenu select all
  doMenu clear picture
  choose browse tool
  put 0 into cd fld "%done"
  unlock screen
end ClearScreen
on CloseStack
  global prefshi,shs
  if the visible of cd fld shs is true then send MouseDown to cd btn id 37
  if the visible of cd btn id 97 is true then send MouseUp to cd btn id 97
  put empty into cd fld "Hello!"
  if the freesize of this stack>0 then
    send CleanUp to background
    if item 2 of prefshi=true then
      put cd fld "Wasted" into Cb
      delete char 1 of Cb
      put "Attempting to compact"&&Cb&&"bytes in Quick CompacterΓäó."
      domenu "Compact Stack"
    end if
  end if
  send CleanUp to background
  visual effect wipe left
end CloseStack

on DoIt
  global tst,totsav,nmQC,Numb,TotNumb,STKP,Multcnt,CS,prefshi
  put TKpathName("Leaf",STKP) into SHRTSTKP
  if the shiftkey is down and the mouse is down then exit doit
  put the cantmodify of STKP into CM
  if CM=true then set cantmodify of STKP to false
  if the cantmodify of STKP=true then ---Checks if stack is locked
    put SHRTSTKP&&"can not be opened to compact."
    if item 1 of prefshi=true then
      repeat with i=1 to item 10 of prefshi
        beep
      end repeat
    end if
    if item 12 of prefshi=true then
      if CS="S" or CS="Q1" then
        answer "That stack is locked or in use." with "OK"
      else
        answer "That stack is locked or in use." with "Cancel Run" or "Continue Run"
        if it="Cancel Run" then put 1 into tst
      end if
    end if
    set cursor to watch
    exit Doit
  end if
  if the shiftkey is down and the mouse is down then exit doit
  --End of most Error Checking. Stack should be compactable.
  put the freesize of STKP into FTS
  put the size of STKP into STS
  put the number of chars of FTS into c
  put FTS into Cb
  if c>3 then put (char c-3 of Cb)&"," into char c-3 of Cb
  set lockmessages to true
  lock screen
  go to stack STKP
  if item 5 of prefshi=true then
    unlock screen with visual effect wipe left
  end if
  put the diskspace into dskspace
  put (STS*1.1) into aSTS
  if dskspace<aSTS then
    go to stack nmQC
    put "Not enough disk space to compact"&&SHRTSTKP&"."
    if item 1 of prefshi=true then
      repeat with i=1 to item 10 of prefshi
        beep
      end repeat
    end if
    if item 12 of prefshi=true then
      if CS="S" or CS="Q1" then
        answer "Disk space error." with "OK"
      else
        answer "Disk space error." with "Cancel Run" or "Continue Run"
        if it="Cancel Run" then put 1 into tst
      end if
    end if
    set cursor to watch
    if CS="MS" then wait 45 ticks
    unlock screen with visual effect wipe left
    set lockmessages to false
    exit DoIt
  end if
  put the userlevel into ulstk
  if ulstk<3 then
    go to stack nmQC
    put SHRTSTKP&&"is protected, can't be compacted."
    if item 1 of prefshi=true then
      repeat with i=1 to item 10 of prefshi
        beep
      end repeat
    end if
    if CS="MS" then wait 45 ticks
    unlock screen with visual effect wipe left
    set lockmessages to false
    exit DoIt
  end if
  put "Attempting to compact"&&Cb&&"bytes in"&&SHRTSTKP&"."
  set the cantmodify of this stack to false
  choose browse tool
  domenu compact stack
  if CM=true then set the cantmodify of this stack to CM
  if item 5 of prefshi=true then lock screen
  go to stack nmQC
  if item 5 of prefshi=true then
    unlock screen with visual effect wipe left
    lock screen
  end if
  set lockMessages to false
  if the freesize of STKP>0 then ---last minute error checking!
    put "The stack could not be correctly compacted."
    if item 1 of prefshi=true then
      repeat with i=1 to item 10 of prefshi
        beep
      end repeat
    end if
    if item 12 of prefshi=true then
      if CS="S" or CS="Q1" then
        answer "There was an unexpected error." with "OK"
      else
        answer "There was an unexpected error." with "Cancel Run" or "Continue"
        if it="Cancel Run" then put 1 into tst
      end if
    end if
    set cursor to watch
    exit Doit
  end if
  add 1 to Multcnt
  put "Compacted"&&CB&&"bytes in"&&SHRTSTKP&"."
  if item 4 of prefshi=true then
    if item 1 of prefshi=true then
      repeat with i=1 to item 11 of prefshi
        beep
      end repeat
    end if
  end if
  put the number of lines in cd fld "Title" into LnsRep
  add 1 to LnsRep
  put (FTS/STS*100) into Prs
  if Prs<1 and PrsΓëá0 then put "<1" into prs else put round((FTS/STS)*100) into Prs
  put Prs&&"%" into line(LnsRep) of cd fld "PerSaved"
  put SHRTSTKP into line(LnsRep) of cd fld "Title"
  put Cb into line(LnsRep) of cd fld "BSaved"
  add FTS to totsav
  put the number of chars of totsav into c
  put totsav into tCb
  if c>3 then put (char c-3 of tCb)&"," into char c-3 of tCb
  put the number of chars of totsav into c
  if c>6 then put (char c-6 of tCb)&"," into char c-6 of tCb
  put tCb into cd fld "Totsavings"
  put totsav into cd fld "Totsavings2"
  unlock screen
end Doit
on RemoveIt
  global itemQL,tst,CS,itemQL2
  answer "Remove this stack from the Quick List?" with "OK" or "Cancel"
  if it="OK" then
    delete item itemQL of cd fld "QListform"
    delete line itemQL-1 of cd fld "QuickList"
    put 1 into itemQL2
  end if
  if CS="Q2" then answer "Continue compacting the Quick List?" with "Cancel Run" or "Continue Run"
  if it="Cancel Run" then  put 1 into tst
end RemoveIt
on QcCheck
  global STKP,prefshi,tst,QCErr
  put empty into QCErr
  put "Checking stack: "&TKpathName("Leaf",STKP)
  put FileExists(STKP) into Exist
  if Exist="False" then
    put TKpathName("Leaf",STKP)&&"does not exist. Remove it from the Quick List."
    if item 12 of prefshi=true then
      answer "That stack does not exist." with "Remove It" or "Cancel Run" or "Continue Run"
      if it="Cancel Run" then put 1 into tst
      if it="Remove It" then
        RemoveIt
      end if
    else
      wait 180 ticks
    end if
    put "error" into QCErr
    set cursor to watch
  end if
end QcCheck
on OsErr err
  if err > 0 then
    put "Parameter error with function" into errstr
  else if err is -59 then
    put "Problem during rename" into errstr
  else if err is -54 then
    put "Attempt to open locked file for writing" into errstr
  else if err is -46 then
    put "Volume locked by software" into errstr
  else if err is -45 then
    put "File locked" into errstr
  else if err is -44 then
    put "Volume locked by hardware" into errstr
  else if err is -43 then
    put "File not found" into errstr
  else if err is -37 then
    put "Bad volume or file name" into errstr
  else if err is -36 then
    put "I/O error" into errstr
  else if err is -35 then
    put "No such volume" into errstr
  else if err is -34 then
    put "Disk is full" into errstr
  else if err is -49 then
    put "Sorry, File already open for writing" into errstr
  else
    put "Sorry, failed with error" && err into errstr
  end if
  put "." after errstr
  answer errstr with "OK"
end OsErr